C--------------------------------------------------------------------------- 

C Program name: Menus test program.

C Author: Gareth Williams

C Description:

C Modification history : (Version), (Date), (Name), (Description).

C 1.0, 1st March 1991, G. Williams, First Version.

C----------------------------------------------------------------------------

C--------------------------------------------------------------------------

         PROGRAM menutest
         LOGICAL menuquit, picked
         INTEGER itemnum
         INTEGER ptkf_stringtoint
         LOGICAL ptkf_readphinterscript
         LOGICAL getmenupick
         LOGICAL docolour
        
         include './sunphigs77.h'
         include './sunptk77.h'

         implicit undefined (P, p, E, e)

C     open PHIGS 
         print *,('Testing the menus utility of the PHIGS Toolkit...')
         print *,('Opening SunPHIGS...')

         call popph(6, 0)
 
C     create the workstation type (either tool or canvas) 
              
C     open the workstation 
       
       if (ptkf_readphinterscript('../../scripts/openws.scr', 0, 0) .eq.
& .FALSE.) then     
         goto 20
       endif

C     define colour variable
C     for a MONOCHROME workstation set this value to .FALSE.

         docolour = .TRUE.

         call psdus(1, PWAITD, PNIVE)
       
         call ptkf_inithashtables()
         call ptkf_createhashtable('structureid', 0, 100)
         call ptkf_createhashtable('viewindex', 1, 100)
         call ptkf_createhashtable('label', 0, 100)
         call ptkf_createhashtable('nameset', 0, 100)
         call ptkf_createhashtable('menuid', 1, 100)
         call ptkf_createhashtable('colourindex', 1, 100)
         call ptkf_createhashtable('name', 1, 100)
              
C     set colours 
         if (docolour .eq. .TRUE.) then
           call ptkf_setcolourrep(1, 'black')
           call ptkf_setcolourrep(1, 'GREEN')
           call ptkf_setcolourrep(1, 'white')
           call ptkf_setcolourrep(1, 'MEDIUM GREEN')
           call ptkf_setcolourrep(1, 'MAGENTA')
           call ptkf_setcolourrep(1, 'MEDIUM MAGENTA') 
           call ptkf_setcolourrep(1, 'GREY')
  
           call ptkf_setbackgroundcolourind(1, 
& ptkf_stringtoint('colourindex', 'grey'))
         endif
     
C     menus to select type of menu and type of input 
       
         call makemainmenu(docolour)
       
         call makeinputmenu(docolour)
       
C     create test box, user and rotator menus 
       
         call createbox(docolour)
       
         call createrotator(docolour)
       
C     interaction loop 
C     draw main menu 
       
         menuquit = .FALSE.
 10      call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
& 'mainmenu'))
         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
& 'inputmenu'))    
         call prst(1, PALWAY)

         itemnum = 0
         picked = getmenupick(ptkf_stringtoint('menuid', 'mainmenu'), 
& itemnum)
         if (picked .eq. .TRUE.) then
           if (itemnum .eq. 1) then
            call testboxmenu()
           else if (itemnum .eq. 2) then
            call testrotator()
           else
            menuquit = .TRUE.
           endif
         else
           print *,('You didnt pick a menu.')
         endif

         if (menuquit .eq. .TRUE.) then
           goto 20
         else 
           goto 10
         endif

 20      print *,('Closing PHIGS...')
         call pclwk(1)
         call pclph()

         STOP
         END

C--------------------------------------------------------------------------
      
         SUBROUTINE pickinput(itemnum)
         INTEGER itemnum, err
         INTEGER menuset(20), emptyset(20), menunames(20)
         INTEGER totsize, i
         REAL pickecho(4)
         INTEGER stat, ppd
         INTEGER pp(3, 20), ppath(3, 20)
         INTEGER ia(2), ldr, err, lstr(1)
         REAL rl(4)
         CHARACTER*80 str, datrec(10)
         LOGICAL picked
         LOGICAL ptkf_pickscanmenus

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)

C test picking 
         itemnum = 0
         print *,('Pick a menu item...')
C initialise pick 
      
         call ptkf_inqpostedmenus(1, 20, menuset, totsize, err)
         do 10, i=1,totsize
           call ptkf_inqmenuname(menuset(i), menunames(i), err)
 10      continue

         call pspkft(1, 1, totsize, menunames, 0, emptyset)
      
         call ptkf_limit(0.0, 1.0, 0.0, 1.0, pickecho)
      
         ia(1) = 2
         ia(2) = 2
         rl(1) = 0.3
         rl(2) = 1.0

         call pprec(2, ia, 2, rl, 0, lstr, str, 10, err, ldr, datrec)

         call pinpk(1, 1, PNPICK, 0, pp, 2, 0.0, 1.0, 0.0, 1.0, 
& ldr, datrec, PPOBOT) 
         
C set pick 
         call pspkm(1, 1, PREQU, PECHO)
         
C request pick 

         call prqpk(1, 1, 10, stat, ppd, ppath)
         
         if (stat .eq. POK) then
           picked = ptkf_pickscanmenus(ppd, ppath, PPOBOT, menuid, 
& itemnum) 
           if (picked .eq. .TRUE.) then
             print *,'menu item', itemnum, 'was picked from menu', 
& menuid
           else
             print *,('You did not pick a menu.')
           endif
         else
           print *,('Nothing picked.')
         endif

         RETURN
         END

C--------------------------------------------------------------------------
         
         LOGICAL FUNCTION getmenupick(menuid, itemnum)
         INTEGER menuid, itemnum, err
         INTEGER pmenuid
         REAL pickecho(4)
         INTEGER menuset(10), emptyset(10)
         INTEGER stat, ppd
         INTEGER pp(3, 20), ppath(3, 20)
         INTEGER ia(2), ldr, err, lstr(1)
         REAL rl(4)
         CHARACTER*80 str, datrec(10)
         LOGICAL ptkf_pickscanmenus

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)

C make menu pickable 
         call ptkf_inqmenuname(menuid, menuset(1), err)
         call pspkft(1, 1, 1, menuset, 0, emptyset)

         call ptkf_limit(0.0, 1.0, 0.0, 1.0, pickecho)
      
         ia(1) = 2
         ia(2) = 2
         rl(1) = 0.3
         rl(2) = 1.0

         call pprec(2, ia, 2, rl, 0, lstr, str, 10, err, ldr, datrec)

         call pinpk(1, 1, PNPICK, 0, pp, 2, 0.0, 1.0, 0.0, 1.0, ldr, 
& datrec, PPOBOT) 
         
C set pick 
         call pspkm(1, 1, PREQU, PECHO)
         
C request pick 

         call prqpk(1, 1, 10, stat, ppd, ppath)
         
         if (stat .eq. POK) then
           getmenupick = ptkf_pickscanmenus(ppd, ppath, PPOBOT, 
& pmenuid, itemnum)
         else
           getmenupick = .FALSE.
         endif

         RETURN
         END

C--------------------------------------------------------------------------
         
         SUBROUTINE pointinput(itemnum)
         INTEGER itemnum
         REAL echovol(4)
         CHARACTER*80 datrec
         INTEGER stat, view
         REAL point(2)
         INTEGER menuid
         REAL value(2)
         LOGICAL picked
         LOGICAL ptkf_locscanmenus

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)

         itemnum = 0
         print *,('Point at a menu item...')
         echovol(1) = 0.0
         echovol(3) = 0.0
         echovol(2) = 1.0
         echovol(4) = 1.0
         call pinlc(1, 1, 0, 0.5, 0.5, 1, 0.0, 1.0, 0.0, 1.0, 0, 
& datrec)
         call pslcm(1, 1, PREQU, PECHO)
         call prqlc(1, 1, stat, view, point(1), point(2))
         if (stat .eq. POK) then
           picked = ptkf_locscanmenus(1, point, menuid, itemnum, 
& value) 
           if (picked .eq. .TRUE.) then
             print *,'menu item', itemnum, 'was pointed at from menu',
& menuid
             print *,'value, x =', value(1), 'y =', value(2)
           endif
         else
           print *,('You did not point at a menu.')
         endif

         RETURN
         END

C--------------------------------------------------------------------------
         
         SUBROUTINE stringinput(itemnum)
         INTEGER itemnum
         CHARACTER*30 dummystr
         INTEGER dummylen
         REAL echoarea(4)
         LOGICAL picked
         LOGICAL ptkf_stringscanmenus

         implicit undefined (P, p, E, e)

         itemnum = 0
         print *,('Enter a menu item...')    
         call ptkf_limit(0.0, 0.25, 0.0, 0.01, echoarea)
         call ptkf_readstring(1, '', 'Type menu item name >', echoarea, 
& 30, dummystr, dummylen)
         picked = ptkf_stringscanmenus(1, dummystr, menuid, itemnum)
         if (picked .eq. .TRUE.) then
           print *,'menu item', itemnum, 'was entered from menu', 
& menuid
         else 
           print *,('No menu item of that name.')
         endif

         RETURN
         END

C--------------------------------------------------------------------------
         
         SUBROUTINE makemainmenu(docolour)
         LOGICAL docolour
         INTEGER err
         REAL topleft(2), box(2)
         INTEGER textind
         REAL charht
         INTEGER white, green, black
         INTEGER mainmenuid
         INTEGER ptkf_stringtoint

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)
         
C create a BOX menu 
C set up main menu - box menu(box, user, rotator, exit) 

         mainmenuid = ptkf_stringtoint('menuid', 'mainmenu') 
         call ptkf_point(0.2, 0.1, box)
         textind = 1
         charht = 0.025
         call ptkf_point(0.8, 1.0, topleft)

         call ptkf_createboxmenu(mainmenuid, topleft, box)

         if (docolour .eq. .TRUE.) then
           white = ptkf_stringtoint('colourindex', 'white')
           green = ptkf_stringtoint('colourindex', 'green')
           black = ptkf_stringtoint('colourindex', 'black')
           call ptkf_setboxmenuattrs(1, mainmenuid, PDOWN, 1, 
& white, green, green, white, black, white, green, green)
         endif

         call ptkf_createtextmenuitem(mainmenuid, 'box', 1, PINSRT, err)
         call ptkf_createtextmenuitem(mainmenuid, 'rotator', 2, PINSRT, 
& err)
         call ptkf_createtextmenuitem(mainmenuid, 'exit', 3, PINSRT, 
& err)

         RETURN
         END

C--------------------------------------------------------------------------
         
         SUBROUTINE makeinputmenu(docolour)
         LOGICAL docolour
         INTEGER err
         REAL topleft(2), box(2)
         INTEGER textind
         REAL charht
         INTEGER white, magenta, black, darkmagenta
         INTEGER inputmenuid
         INTEGER ptkf_stringtoint

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)
         
         inputmenuid = ptkf_stringtoint('menuid', 'inputmenu') 
         call ptkf_point(0.2, 0.1, box)
         textind = 1
         charht = 0.03
         call ptkf_point(0.8, 0.5, topleft)

         call ptkf_createboxmenu(inputmenuid, topleft, box)

         if (docolour .eq. .TRUE.) then
           white = ptkf_stringtoint('colourindex', 'white')
           magenta = ptkf_stringtoint('colourindex', 'magenta')
           darkmagenta = ptkf_stringtoint('colourindex',
& 'medium magenta')
           black = ptkf_stringtoint('colourindex', 'black')
           call ptkf_setboxmenuattrs(1, inputmenuid, PDOWN, 1, 
& white, magenta, magenta, white, black, white, darkmagenta, 
& darkmagenta)
         endif

         call ptkf_createtextmenuitem(inputmenuid, 'pick', 1, PINSRT, 
& err)
         call ptkf_createtextmenuitem(inputmenuid, 'point', 2, PINSRT, 
& err)
         call ptkf_createtextmenuitem(inputmenuid, 'string', 3, PINSRT, 
& err)
         call ptkf_createtextmenuitem(inputmenuid, 'exit', 4, PINSRT, 
& err)

         RETURN
         END

C--------------------------------------------------------------------------
         
         SUBROUTINE createbox(docolour)
         LOGICAL docolour
         INTEGER err
         REAL topleft(2), box(2)
         INTEGER textind
         REAL charht
         INTEGER white, green, black, darkgreen
         INTEGER boxmenuid
         INTEGER ptkf_stringtoint

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)
         
         boxmenuid = ptkf_stringtoint('menuid', 'boxmenu')
         call ptkf_point(0.2, 0.1, box)
         textind = 1
         charht = 0.03
         call ptkf_point(0.0, 0.0, topleft)

         call ptkf_createboxmenu(boxmenuid, topleft, box)

         if (docolour .eq. .TRUE.) then
           white = ptkf_stringtoint('colourindex', 'white')
           green = ptkf_stringtoint('colourindex', 'green')
           darkgreen = ptkf_stringtoint('colourindex', 'medium green')
           black = ptkf_stringtoint('colourindex', 'black')
           call ptkf_setboxmenuattrs(1, boxmenuid, PDOWN, 1, 
& white, green, green, white, black, white, darkgreen, darkgreen) 

         endif

         call ptkf_point(0.5, 0.7, topleft)
         call ptkf_setmenuposition(boxmenuid, topleft)
         
         call ptkf_createtextmenuitem(boxmenuid, 'item 1', 1, PINSRT, 
& err)
         call ptkf_createtextmenuitem(boxmenuid, 'item 2', 2, PINSRT, 
& err)
         call ptkf_createtextmenuitem(boxmenuid, 'item 3', 3, PINSRT, 
& err)
         call ptkf_createtextmenuitem(boxmenuid, 'item 4', 4, PINSRT, 
& err)
         

         RETURN
         END
         
C--------------------------------------------------------------------------
                 
         SUBROUTINE createrotator(docolour)
         LOGICAL docolour
         REAL size(2), pos(2)
         INTEGER green, white, black
         INTEGER rotator1, rotator2, rotator3
         INTEGER ptkf_stringtoint

         include './sunptk77.h'

         implicit undefined (P, p, E, e)
         
C create a rotator 
         rotator1 = ptkf_stringtoint('menuid', '1drotator')
         rotator2 = ptkf_stringtoint('menuid', '2drotator')
         rotator3 = ptkf_stringtoint('menuid', '3drotator')
         call ptkf_point(0.2, 0.2, size)
         call ptkf_createrotator(1, rotator1, PTKEONED, size, 
& '1D rotator', 0.02)
         call ptkf_createrotator(1, rotator2, PTKETWOD, size, 
& '2D rotator', 0.02)
         call ptkf_point(0.3, 0.2, size)
         call ptkf_createrotator(1, rotator3, PTKETHREED, size, 
& '3D rotator', 0.02)
         if (docolour .eq. .TRUE.) then
           green = ptkf_stringtoint('colourindex', 'green')
           white = ptkf_stringtoint('colourindex', 'white')
           black = ptkf_stringtoint('colourindex', 'black')
           call ptkf_setrotatorattrs(1, rotator1, 1, white, green,
& white, green, white, green, white, black)
           call ptkf_setrotatorattrs(1, rotator2, 1, white, green,
& white, green, white, green, white, black)
           call ptkf_setrotatorattrs(1, rotator3, 1, white, green,
& white, green, white, green, white, black)
         endif

         call ptkf_point(0.5, 0.3, pos)
         call ptkf_setmenuposition(rotator1, pos)
         call ptkf_point(0.5, 0.55, pos)
         call ptkf_setmenuposition(rotator2, pos)
         call ptkf_point(0.5, 0.8, pos)
         call ptkf_setmenuposition(rotator3, pos)

         call ptkf_setrotatortitle(rotator1, 'zoom')

         RETURN
         END
         
C--------------------------------------------------------------------------
         
         SUBROUTINE testboxmenu()
         LOGICAL boxmenuquit, picked
         INTEGER itemnum
         LOGICAL getmenupick
         INTEGER ptkf_stringtoint

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)

         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 'mainmenu'))  
         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 'inputmenu'))
         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 'boxmenu'))  

         call prst(1, PALWAY)
         boxmenuquit = .FALSE.

 10      itemnum = 0
         picked = getmenupick(ptkf_stringtoint('menuid', 'inputmenu'), 
& itemnum) 
         if (picked .eq. .TRUE.) then

            call ptkf_setboxmenuhighlightitem(ptkf_stringtoint('menuid',
& 'inputmenu'), itemnum)
            call prst(1, PALWAY)

            if (itemnum .eq. 1) then
              call pickinput(itemnum)
              call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
& 'menuid', 'boxmenu'), itemnum)
            else if (itemnum .eq. 2) then
              call pointinput(itemnum)
              call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
& 'menuid', 'boxmenu'), itemnum)
            else if (itemnum .eq. 3) then
              call stringinput(itemnum)
              call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
& 'menuid', 'boxmenu'), itemnum)
            else
              boxmenuquit = .TRUE.
            endif
         endif

         call prst(1, PALWAY)

         if (boxmenuquit .eq. .TRUE.) then
           goto 20
         else 
           goto 10
         endif

 20      call ptkf_clearboxmenuhighlight(ptkf_stringtoint('menuid', 
& 'inputmenu'))
         call ptkf_clearboxmenuhighlight(ptkf_stringtoint('menuid', 
& 'boxmenu'))
         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 'boxmenu'))

         RETURN
         END
            
C--------------------------------------------------------------------------
          
         SUBROUTINE testrotator()
         LOGICAL rotatorquit, picked
         INTEGER err, itemnum
         LOGICAL getmenupick
         INTEGER ptkf_stringtoint

         include './sunphigs77.h'

         implicit undefined (P, p, E, e)

         call ptkf_delmenuitem(ptkf_stringtoint('menuid', 
& 'inputmenu'), 3)
         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
& 'mainmenu'))  
         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
& 'inputmenu'))
          
         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
& '1drotator'))
         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
& '2drotator'))
         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 
& '3drotator'))
         call prst(1, PALWAY)
         rotatorquit = .FALSE.
 10      itemnum = 0
         picked = getmenupick(ptkf_stringtoint('menuid', 'inputmenu'),
& itemnum)
         if (picked .eq. .TRUE.) then
            if (itemnum .eq. 1) then
              call pickinput(itemnum)
            else if (itemnum .eq. 2) then
              call pointinput(itemnum)
            else
              rotatorquit = .TRUE.
            endif
         endif

         if (rotatorquit .eq. .TRUE.) then
           goto 20
         else 
           goto 10
         endif

 20      call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
& '1drotator'))
         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
& '2drotator'))
         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 
& '3drotator'))
         call ptkf_createtextmenuitem(ptkf_stringtoint('menuid', 
& 'inputmenu'), 'string', 3, PINSRT, err)

         RETURN
         END
          
C--------------------------------------------------------------------------
          
C     end of menutest.f
